home *** CD-ROM | disk | FTP | other *** search
/ Whiteline: Alpha / Whiteline Alpha.iso / progtool / pascal / o_gem / source / clipview.pas next >
Encoding:
Pascal/Delphi Source File  |  1994-09-22  |  2.6 KB  |  114 lines
  1. {$IFDEF DEBUG}
  2.     {$B+,D+,G-,I-,L+,N-,P-,Q+,R+,S+,T-,V-,X+,Z+}
  3. {$ELSE}
  4.     {$B+,D-,G-,I-,L-,N-,P-,Q-,R-,S-,T-,V-,X+,Z+}
  5. {$ENDIF}
  6.  
  7. program ClipView; { 30.08.1994 }
  8.  
  9. uses
  10.  
  11.     Gem,OTypes,OProcs,OWindows,OStdWnds;
  12.  
  13. type
  14.  
  15.     PCVApplication = ^TCVApplication;
  16.     TCVApplication = object(TApplication)
  17.         procedure InitInstance; virtual;
  18.         procedure InitMainWindow; virtual;
  19.         procedure SCChanged(OrgID: integer; Bits: word; Ext: string); virtual;
  20.     end;
  21.  
  22.     PViewWindow = ^TViewWindow;
  23.     TViewWindow = object(TTextWindow)
  24.         procedure GetWindowClass(var AWndClass: TWndClass); virtual;
  25.         function GetStyle: integer; virtual;
  26.         procedure UpdateSubTitle; virtual;
  27.     end;
  28.  
  29. var
  30.  
  31.     CVApplication   : TCVApplication;
  32.     CVApplicationPtr: PCVApplication;
  33.  
  34.  
  35.  
  36. procedure TCVApplication.InitInstance;
  37.  
  38.     begin
  39.         CVApplicationPtr:=PCVApplication(Application);
  40.         inherited InitInstance
  41.     end;
  42.  
  43.  
  44. procedure TCVApplication.InitMainWindow;
  45.     var p  : PViewWindow;
  46.         ext: string;
  47.  
  48.     begin
  49.         new(p,Init(nil,Name^,100,50));
  50.         if (MainWindow=nil) or (ChkError<em_OK) then Status:=em_InvalidMainWindow;
  51.         p^.SetSubTitle(' Keine Textdatei im Klemmbrett vorhanden.');
  52.         if Clipboard=nil then exit;
  53.         with Clipboard^ do
  54.             begin
  55.                 if not(OpenClipboard(false)) then exit;
  56.                 ext:=GetPriorityClipboardFormat('TXT.ASC.RTF.TEX.CSV.EPS');
  57.                 if length(ext)>0 then
  58.                     begin
  59.                         p^.Read(GetClipboardFilename+ext);
  60.                         p^.SetSubTitle(' '+GetClipboardFilename+ext+'  ('+ltoa(p^.GetNumLines)+' Zeile(n))')
  61.                     end;
  62.                 CloseClipboard
  63.             end
  64.     end;
  65.  
  66.  
  67. procedure TCVApplication.SCChanged(OrgID: integer; Bits: word; Ext: string);
  68.     var ret: string;
  69.  
  70.     begin
  71.         MainWindow^.SetSubTitle(' Keine Textdatei im Klemmbrett vorhanden.');
  72.         if Clipboard=nil then exit;
  73.         if not(bTst(Bits,SCF_TEXT)) then exit;
  74.         with Clipboard^ do
  75.             begin
  76.                 if not(OpenClipboard(false)) then exit;
  77.                 ret:=GetPriorityClipboardFormat('TXT.ASC.RTF.TEX');
  78.                 if length(ret)>0 then
  79.                     begin
  80.                         PViewWindow(MainWindow)^.Clear;
  81.                         PViewWindow(MainWindow)^.Read(GetClipboardFilename+ret);
  82.                         MainWindow^.SetSubTitle(' '+GetClipboardFilename+ret+'  ('+ltoa(PViewWindow(MainWindow)^.GetNumLines)+' Zeile(n))')
  83.                     end;
  84.                 CloseClipboard
  85.             end
  86.     end;
  87.  
  88.  
  89. procedure TViewWindow.GetWindowClass(var AWndClass: TWndClass);
  90.  
  91.     begin
  92.         inherited GetWindowClass(AWndClass);
  93.         with AWndClass do Style:=Style or cs_QuitOnClose
  94.     end;
  95.  
  96.  
  97. function TViewWindow.GetStyle: integer;
  98.  
  99.     begin
  100.         GetStyle:=inherited GetStyle or INFO
  101.     end;
  102.  
  103.  
  104. procedure TViewWindow.UpdateSubTitle;
  105.  
  106.     begin
  107.     end;
  108.  
  109.  
  110. begin
  111.     CVApplication.Init('VCLP','ClipView');
  112.     CVApplication.Run;
  113.     CVApplication.Done
  114. end.